home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr14 / eclife_a.zip / LIFE.TXT < prev   
Text File  |  1993-06-06  |  2KB  |  75 lines
  1. \ Free from Elliott Chapin (416) 921-9560.
  2. \ L.O.V.E. Forth source code for LIFE.EXE.
  3. \ Please distribute both files together only.
  4. \ The program requires 80x25 colour text mode & an MS-compatible mouse.
  5.  
  6. : FOO ;
  7.  
  8. ASCII O CONSTANT BLOT  32 CONSTANT BLANK
  9.  
  10. 72 CONSTANT UP  80 CONSTANT DOWN  77 CONSTANT RIGHT  75 CONSTANT LEFT
  11.  
  12. CREATE LIVES 2000 ALLOT  CREATE NEXTLIVES 2000 ALLOT
  13.  
  14. VARIABLE NEIGHBOURS
  15.  
  16. : AROUND ( a -- n )
  17.  0 NEIGHBOURS !
  18.  DUP 80 - DUP DUP 1- C@ 2*  NEIGHBOURS +!
  19.                      C@ 3 * NEIGHBOURS +!
  20.                   1+ C@ 2*  NEIGHBOURS +!
  21.  DUP      DUP DUP 1- C@ 3 * NEIGHBOURS +!
  22.                      C@     NEIGHBOURS +!
  23.                   1+ C@ 3 * NEIGHBOURS +!
  24.      80 + DUP DUP 1- C@ 2*  NEIGHBOURS +!
  25.                      C@ 3 * NEIGHBOURS +!
  26.                   1+ C@ 2*  NEIGHBOURS @ + ;
  27.  
  28. : NEWFIELD 2000 0 DO 0 LIVES I + C! LOOP
  29.            LIVES NEXTLIVES 2000 CMOVE
  30.            25 0 DO CR LOOP
  31.            37 12 XYTAB
  32.          BEGIN QTERM
  33.           IF KEY
  34.            CASE
  35.             ASCII 1 OF XY@ 2DUP 80 * + LIVES + 1 SWAP C!
  36.                        2DUP BLOT EMIT XYTAB ENDOF
  37.             ASCII 0 OF XY@ 2DUP 80 * + LIVES + 0 SWAP C!
  38.                        2DUP BLANK EMIT XYTAB ENDOF
  39.             ASCII R OF EXIT ENDOF
  40.             ASCII r OF EXIT ENDOF
  41.             ASCII G OF BYE ENDOF
  42.             ASCII g OF BYE ENDOF
  43.             0 OF SCANCODE @
  44.                   CASE
  45.                    UP OF XY@ DUP IF 1- XYTAB THEN ENDOF
  46.                    DOWN OF XY@ DUP 24 < IF 1+ XYTAB THEN ENDOF
  47.                    RIGHT OF XY@ OVER 79 < IF SWAP 1+ SWAP XYTAB THEN ENDOF
  48.                    LEFT OF XY@ OVER IF SWAP 1- SWAP XYTAB THEN ENDOF
  49.                   ENDCASE  ENDOF
  50.            ENDCASE
  51.           THEN
  52.          AGAIN ;
  53.  
  54. : NEXTGEN    24 1 DO  79 1 DO
  55.    I J 80 * + LIVES + DUP C@
  56.    IF DUP AROUND DUP 4 > SWAP 10 < AND
  57.     IF LIVES - NEXTLIVES + 1 SWAP C!
  58.     ELSE  LIVES - NEXTLIVES + 0 SWAP C! THEN
  59.   ELSE DUP AROUND DUP 6 > SWAP 10 < AND
  60.     IF LIVES - NEXTLIVES + 1 SWAP C!
  61.     ELSE  LIVES - NEXTLIVES + 0 SWAP C! THEN
  62.   THEN LOOP LOOP ;
  63.  
  64. : UPDATE
  65.  NEXTLIVES LIVES 2000 CMOVE
  66.  24 1 DO  79 1 DO
  67.  I J 80 * + DUP NEXTLIVES + 0 SWAP C! LIVES + C@
  68.   IF I J XYTAB BLOT EMIT
  69.   ELSE I J XYTAB BLANK EMIT
  70.   THEN LOOP LOOP ;
  71.  
  72. : RUN BEGIN NEXTGEN UPDATE ?TERMINAL UNTIL ;
  73.  
  74. : LIFE BEGIN NEWFIELD RUN AGAIN ;
  75.